perm filename HAND.SAI[SYS,HE]2 blob
sn#012378 filedate 1972-11-13 generic text, type T, neo UTF8
00100 BEGIN
00200 IFC FALSE THENC "WAVE"
00300 DEFINE WAVE="TRUE",GRAPHICS="FALSE";
00400 ELSEC "HAND"
00500 DEFINE WAVE="FALSE",GRAPHICS="FALSE";
00600 ENDC
00700 REQUIRE -1 NEW_ITEMS;
00800 REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
00900 REQUIRE "DRIVE.REL[SYS,HE]" LOAD_MODULE;
01000 EXTERNAL SIMPLE PROCEDURE ARMPOS;
01100 EXTERNAL SIMPLE PROCEDURE HANDFN;
01200 EXTERNAL SIMPLE PROCEDURE ARMFN(INTEGER NARGS);
01300 EXTERNAL SIMPLE PROCEDURE ARMPROCEED;
01400 EXTERNAL SIMPLE PROCEDURE DOIT(INTEGER BAND,FILE);
01500 EXTERNAL SIMPLE PROCEDURE ARM_JOINT;
01600 REAL ROTAT;
01700 SAFE REAL ARRAY TRANS[1:4,1:4];
01800 INTERNAL SAFE INTEGER ARRAY ARM_MESSAGE[1:21];
01900 INTEGER IFI,I,J,MESS;
02000 BOOLEAN FRST_OPEN,AEF;
02100 BOOLEAN TEST;
02200 INTEGER N,CHAN;
02300 REAL TX,TY,TZ;
02400 INTEGER HAND;
02500 STRING FILE;
02600 INTEGER BREAK,EOF;
02700 INTEGER PTR1,PTR2,PTR3,PTR4;
02800 SAFE REAL ARRAY TH,DIR[1:6];
02900 DEFINE MP="MESSAGE";
03000 PRELOAD_WITH -180.0, -90.0, 12.0, -90.0, 90.0, 0.0;
03100 SAFE REAL ARRAY V0[1:6];
03200 LABEL EXETRUE,GGET,GET,GET1;
03300 DEFINE TTY="1",ONE_LINE="1",HEAD="2",ID="3",DEL="4";
03310 DEFINE OCTNUM="5",RSB="6",LN="7",SOME="10";
03400 DEFINE NUMS="11",NNUMS="12",DOLLAR="13",SOMETHING="14";
03500 DEFINE FREE_DATA_LENGTH="100",MAX_STACK="150";
03600 SAFE INTEGER ARRAY RELOC,STACK[1:MAX_STACK];
00100 IFC WAVE THENC
00200 REQUIRE 2000 STRING_SPACE;
00300 REQUIRE "HASH06.REL[SYS,HE]" LOAD_MODULE;
00400 EXTERNAL SIMPLE INTEGER PROCEDURE HASH(STRING S);
00500 EXTERNAL SIMPLE INTEGER PROCEDURE REHASH;
00600 STRING LINE_NO,S;
00700 SAFE REAL ARRAY XT[1:4,1:4];
00800 SAFE REAL ARRAY XV,YV,ZV[1:4];
00900 STRING ARRAY MACRO_FORMAL,MACRO_NAME,MACRO_SOURCE,MACRO_DEFN,FILE_NAME[1:15];
01000 SAFE INTEGER ARRAY MAC_TOP[0:14];
01100 INTEGER FMN,MAC_EOF,MAC,MAC_FREE;
01200 DEFINE MAX_PAR="30";
01300 SAFE STRING ARRAY MAC_PAR[1:MAX_PAR];
01400 DEFINE MAX_LABELS="100";
01500 STRING ARRAY LABEL_LINE,LABELS[1:MAX_LABELS];
01600 INTEGER ARRAY BBEG,LLAB[1:15];
01700 INTEGER FREEL;
01800 INTEGER ARRAY PTRS[1:MAX_LABELS];
01900 STRING ARRAY CODE_LINE,REF[1:MAX_STACK];
02000 STRING ARRAY FUNNAM[0:'77];
02100 INTEGER ARRAY FUNNUM[0:'77];
02200 STRING ARRAY VECTNAM[0:'77];
02300 STRING ARRAY TRANSNAM[0:'77];
02400 INTEGER ARRAY TRANSNUM[0:'77];
02500 INTEGER ARRAY VECTNUM[0:'77];
02550 SAFE STRING ARRAY SAVE_NAME[1:10];INTEGER MSN;
02600 SAFE REAL ARRAY DATA_BASE[0:FREE_DATA_LENGTH,1:3];
02700 INTEGER FREE_DATA;
02800 SIMPLE STRING PROCEDURE SIMIO(REFERENCE INTEGER BR);
02900 BEGIN STRING S;
03000 IF MAC
03100 THEN BEGIN S←SCAN(MACRO_SOURCE[MAC],BR,BREAK);
03200 MAC_EOF←¬(LENGTH(MACRO_SOURCE[MAC]) ∨ LENGTH(S)) END
03300 ELSE S←INPUT(CHAN,BR);
03400 RETURN(S) END"SIMIO";
03500
00100 SIMPLE INTEGER PROCEDURE GETNAME(BOOLEAN NUM;REFERENCE STRING S;STRING ARRAY NAME);
00200 BEGIN LABEL L1;
00300 INTEGER I;
00400 L1: IF NUM THEN SIMIO(NUMS) ELSE SIMIO(HEAD);
00500 IF MAC_EOF
00600 THEN BEGIN
00700 FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
00800 DO FOR J←BBEG[MAC] STEP 1 UNTIL PTR3
00900 DO IF EQU(REF[J],LABELS[I])
01000 THEN BEGIN
01100 START_CODE
01200 MOVE 1,STACK;
01300 ADD 1,J;
01400 HRRE 1,-1(1);
01500 MOVEM 1,N END;
01600 N←PTRS[I]-J+N;
01700 REF[J]←NULL;
01800 IF N+J<1 ∨ N+J>PTR3+1
01900 THEN BEGIN
02000 OUTSTR(CODE_LINE[J]&"JUMP OUT OF RANGE"&'15&'12);
02100 N←PTR3+1-J END;
02200 STACK[J]←(N LAND '777777) LOR '102000000 END;
02300 MAC_FREE←MAC_TOP[MAC];
02400 MAC←MAC-1;
02500 MAC_EOF←0;
02600 IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*")END;
02700 GO TO L1 END;
02800 IF EOF THEN BEGIN RELEASE(CHAN);
02900 CHAN←CHAN-1;
03000 IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*")END;
03100 GO TO L1; END;
03200 IF BREAK=-1
03300 THEN BEGIN LINE_NO←SIMIO(LN);
03400 GO TO L1 END;
03500 IF BREAK=";" THEN BEGIN SIMIO(ONE_LINE); GO TO L1 END;
03600 IF BREAK="$"
03700 THEN BEGIN I←INTSCAN(S←SIMIO(NNUMS),J);
03800 I←I+MAC_TOP[MAC];
03900 IF I<1 ∨ I> MAC_FREE
04000 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
04100 GO TO L1 END;
04200 S←MAC_PAR[I] END
04300 ELSE S←IF NUM THEN SIMIO(NNUMS) ELSE SIMIO(ID);
04400 IF NUM THEN RETURN(-1);
04500 IF BREAK=":"
04600 THEN BEGIN
04700 FOR I←LLAB[CHAN] STEP 1 UNTIL FREEL
04800 DO IF EQU(S,LABELS[I])
04900 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&S&" MULTIPLY DEFINED LABEL"&'15&'12);
05000 GO TO L1 END;
05100 LABELS[FREEL←FREEL+1]←S;
05200 LABEL_LINE[FREEL]←FILE_NAME[CHAN]&LINE_NO;
05300 PTRS[FREEL]←PTR3+1;
05400 GO TO L1 END;
05500 I←HASH(S);
05600 WHILE LENGTH(NAME[I])
05700 DO BEGIN IF EQU(S,NAME[I]) THEN DONE;
05800 I←REHASH END;
05900 RETURN(I) END;
06000
00100 FORWARD SIMPLE PROCEDURE CONSTRUCT(REAL ARRAY T,E);
00200
00300 SIMPLE INTEGER PROCEDURE INTERN(STRING S;STRING ARRAY NAME);
00400 BEGIN INTEGER I;
00500 I←HASH(S);
00600 WHILE LENGTH(NAME[I])
00700 DO BEGIN IF EQU(S,NAME[I]) THEN RETURN(I);
00800 I←REHASH END;
00900 NAME[I]←S;
01000 RETURN(I) END;
01100
01200 DEFINE SAY_WAIT="IF ¬MAC ∧ CHAN=1 THEN OUTSTR(WAIT&'15&'12)";
01300
01400 BOOLEAN SIMPLE PROCEDURE READT(REAL ARRAY T;REFERENCE STRING S;STRING MESS);
01500 BEGIN INTEGER I;
01600 SAFE OWN REAL ARRAY E[1:6];
01700 I←GETNAME(FALSE,S,TRANSNAM);
01800 IF LENGTH(TRANSNAM[I])
01900 THEN BEGIN ARRBLT(E[1],DATA_BASE[TRANSNUM[I],1],6);
02000 CONSTRUCT(T,E);
02100 RETURN(TRUE) END;
02200 OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
02300 RETURN(FALSE) END;
02400
02500 BOOLEAN SIMPLE PROCEDURE READV(REAL ARRAY V;REFERENCE STRING S;STRING MESS);
02600 BEGIN INTEGER I;
02700 I←GETNAME(FALSE,S,VECTNAM);
02800 IF LENGTH(VECTNAM[I])
02900 THEN BEGIN ARRBLT(V[1],DATA_BASE[VECTNUM[I],1],3);
03000 V[4]←1;
03100 RETURN(TRUE) END;
03200 OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
03300 RETURN(FALSE) END;
03400
03500 STRING WAIT,OFILE,SL;
03600 SAFE REAL ARRAY TT1[1:4,1:4];
03700 PRELOAD_WITH 20,30,1,180,90,0; SAFE REAL ARRAY ANEW[1:6];
03800 IFC GRAPHICS THENC
03900 REQUIRE"DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
04000 ENDC
04100 STRING FUNCTION,S11,SM,DFILE;
04200 PRELOAD_WITH 100.0, 100.0, 100.0, 100.0, 100.0, 100.0;
04300 SAFE REAL ARRAY THFAC[1:6];
04400 ENDC
00100 REAL R;
00200 SAFE REAL ARRAY VT,VT1,VT2[1:4];
00300 PRELOAD_WITH [2] 0.0, [2] 1.0;
00400 SAFE REAL ARRAY UZ[1:4];
00500 SAFE REAL ARRAY ST[1:6];
00600 INTEGER NMASK,TIP,PAD,HIT,LL,UL,MODULUS,PTR,TIME,INDEX,BP;
00700 REAL FACTOR;
00800 PRELOAD_WITH 0;
00900 SAFE INTEGER ARRAY BUFFER[0:100];
01000 IFC WAVE THENC
01100 ENDC
01200
01300 REQUIRE "TRAJ.SAI" SOURCE_FILE;
01400
00100 IFC WAVE THENC
00200 SIMPLE PROCEDURE CONSTRUCT(REAL ARRAY T,E);
00300 BEGIN
00400 REAL SI1,SI2,SI3,CO1,CO2,CO3;
00500 T[1,4]←E[1]*TSX;
00600 T[2,4]←E[2]*TSY;
00700 T[3,4]←E[3];
00800 SI1←SIND(E[4]);CO1←COSD(E[4]);
00900 SI2←SIND(E[5]);CO2←COSD(E[5]);
01000 SI3←SIND(E[6]);CO3←COSD(E[6]);
01100 T[1,1]←-SI1*SI2*CO3+CO1*SI3;
01200 T[1,2]← SI1*SI2*SI3+CO1*CO3;
01300 T[2,1]← CO1*SI2*CO3+SI1*SI3;
01400 T[2,2]←-CO1*SI2*SI3+SI1*CO3;
01500 T[1,3]← SI1*CO2;
01600 T[2,3]←-CO1*CO2;
01700 T[3,1]←-CO2*CO3;
01800 T[3,2]← CO2*SI3;
01900 T[3,3]←-SI2;
02000 T[4,1]←T[4,2]←T[4,3]←0;
02100 T[4,4]←1;
02200 END;
02300
02400 ENDC
00100 FORMAT_POINTER←-1;
00200 OBJECT_MASS←OBJECT_KXX←OBJECT_KYY←OBJECT_KZZ←FREE_ARM[0,1]←0;
00300 AEF←ARM_EXECUTE←FALSE;
00400 FOR I←1 STEP 1 UNTIL 6 DO FORCE_ARM[I]←0;
00500 PUSH_FORMAT(8,4);
00600 ARM_SEGMENT←0;
00700 ARM_MOTION←0;
00800 FAST←TRUE;
00900 FOR I←0 STEP 1 UNTIL '37 DO BANDS[I]←NULL;
01000 NEXT_BAND←0;
01100 STOP_ON_TOUCH←FALSE;
01200 FOR I←1 STEP 1 UNTIL 6 DO MMOVE(A[SQAR(I)],A[SQAR(I)]);
01300
01400 FILE←"ARM";
01500 MMOVE(Q[0],Q[0]);
01600 MMOVE(Q[17],Q[17]);
01700 FOR I←1 STEP 1 UNTIL 3 DO DEPART_ARM[I]←ARRIVE_ARM[I]←IF I=3 THEN 3.0 ELSE 0.0;
01800 DEPART_ARM[4]←ARRIVE_ARM[4]←1.0;
01900 FOR I←1 STEP 1 UNTIL 6 DO BEGIN
02000 N←SQAR(I);
02100 MMOVE(JMAT[N],JMAT[N])END ;
02200 DO BEGIN
02300 ARM_POSITION;
02400 IF ARM_STATUS THEN
02500 BEGIN OUTSTR("HAND ERROR "&CVOS(ARM_STATUS)&"
02600 CHECK PDP-6 AND TYPE C/R"&CRLF);
02700 INCHWL;
02800 END;
02900 END UNTIL ¬ARM_STATUS;
03000 ARRTRAN(LAST_ARM,ARM_VECTOR);
03100 PUT_DATA(0,0,"HAND");
03200 YES_HAND←-1;
03300 IFC ¬WAVE THENC
03400 OUTSTR(" ***** HAND INITIALIZED *****"&'15&'12);
03500 WHILE TRUE DO QUEUE('600, GET_ENTRY('120,NULL,"HAND",NULL));
00100 ELSEC
00200 WAIT←"O.K.";
00300 OPEN(TTY,"TTY",0,2,0,120,BREAK,EOF);
00400 FILE←NULL;
00500 FREEL←0;
00600 FOR I←1 STEP 1 UNTIL 15 DO LLAB[I]←1;
00700 OFILE←"WAVE";
00800 SETBREAK(ONE_LINE,'12,'15,"IN");
00900 SETBREAK(SOME,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRD");
00950 SETBREAK(SOMETHING,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ"&'12,'15,"ILRD");
01000 SETBREAK(HEAD,"$;ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRD");
01100 SETBREAK(ID,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",NULL,"XN");
01200 SETBREAK(RSB,"]",NULL,"IAN");
01300 SETBREAK(DEL,"() ,;: ",NULL,"IN");
01400 SETBREAK(NUMS,"0123456789.@+-$;",NULL,"ILR");
01500 SETBREAK(NNUMS,"$0123456789.@+-",NULL,"XL");
01600 SETBREAK(DOLLAR,"$",NULL,"I");
01700 SETBREAK(LN," ",NULL,"IA");
01800 NMASK←'777777774000;
01900 CHAN←TTY;
02000 MSN←FMN←MAC←MAC_EOF←EOF←MAC_FREE←0;
02100 FUNNUM[INTERN("DO",FUNNAM)]←0;
02200 FUNNUM[INTERN("REQUIRE",FUNNAM)]←1;
02300 FUNNUM[INTERN("TRANS",FUNNAM)]←2;
02400 FUNNUM[INTERN("VECT",FUNNAM)]←3;
02500 FUNNUM[INTERN("BEGIN",FUNNAM)]←4;
02600 FUNNUM[INTERN("PARK",FUNNAM)]←5;
02700 FUNNUM[INTERN("MOVE",FUNNAM)]←6;
02800 FUNNUM[INTERN("STEP",FUNNAM)]←7;
02900 FUNNUM[INTERN("DRAW",FUNNAM)]←8;
03000 FUNNUM[INTERN("FREE",FUNNAM)]←9;
03100 FUNNUM[INTERN("SPIN",FUNNAM)]←10;
03200 FUNNUM[INTERN("FORCE",FUNNAM)]←11;
03300 FUNNUM[INTERN("STOP",FUNNAM)]←12;
03400 FUNNUM[INTERN("OPEN",FUNNAM)]←13;
03500 FUNNUM[INTERN("SKIPE",FUNNAM)]←14;
03600 FUNNUM[INTERN("JUMP",FUNNAM)]←15;
03700 FUNNUM[INTERN("CLOSE",FUNNAM)]←16;
03800 FUNNUM[INTERN("CENTER",FUNNAM)]←17;
03900 FUNNUM[INTERN("PLACE",FUNNAM)]←18;
04000 FUNNUM[INTERN("CHANGE",FUNNAM)]←19;
04100 FUNNUM[INTERN("DRIVE",FUNNAM)]←20;
04200 FUNNUM[INTERN("WAIT",FUNNAM)]←21;
04300 FUNNUM[INTERN("MERGE",FUNNAM)]←22;
04400 FUNNUM[INTERN("SAVE",FUNNAM)]←23;
04500 FUNNUM[INTERN("RESTORE",FUNNAM)]←24;
04600 FUNNUM[INTERN("TOUCH",FUNNAM)]←25;
04700 FUNNUM[INTERN("CONO",FUNNAM)]←26;
04800 FUNNUM[INTERN("END",FUNNAM)]←27;
04900 FUNNUM[INTERN("FLUSH",FUNNAM)]←28;
05000 FUNNUM[INTERN("P",FUNNAM)]←29;
05100 FUNNUM[INTERN("PROTOTYPE",FUNNAM)]←30;
05200 FUNNUM[INTERN("FILE",FUNNAM)]←31;
05300 FUNNUM[INTERN("I",FUNNAM)]←32;
05400 FUNNUM[INTERN("MOVE_INSTANCE",FUNNAM)]←33;
05500 FUNNUM[INTERN("LINK",FUNNAM)]←34;
05600 FUNNUM[INTERN("GRASP",FUNNAM)]←35;
05700 FUNNUM[INTERN("WEIGHT",FUNNAM)]←36;
05800 FUNNUM[INTERN("WOBBLE",FUNNAM)]←37;
05900 FUNNUM[INTERN("POSITION",FUNNAM)]←38;
06000 FUNNUM[INTERN("SKIPN",FUNNAM)]←39;
06100 FUNNUM[INTERN("SKIPS",FUNNAM)]←40;
06200 FUNNUM[INTERN("DEFINE",FUNNAM)]←41;
06300 FUNNUM[INTERN("DUMP",FUNNAM)]←42;
06350 FUNNUM[INTERN("SET",FUNNAM)]←43;
06400 IFC GRAPHICS THENC FUNNUM[INTERN("DISP",FUNNAM)]←44;ENDC
06500 VECTNUM[INTERN("SWEEP",VECTNAM)]←0;
06600 VECTNUM[INTERN("LIFT",VECTNAM)]←0;
06700 VECTNUM[INTERN("REACH",VECTNAM)]←0;
06800 VECTNUM[INTERN("TURN",VECTNAM)]←0;
06900 VECTNUM[INTERN("TWIST",VECTNAM)]←0;
07000 VECTNUM[INTERN("TILT",VECTNAM)]←0;
07050 VECTNUM[INTERN("NIL",VECTNAM)]←1;
07100 FREE_DATA←2;
07200 OUTSTR("WAVE READY!
07300 DO YOU WANT THE FILES SAVED? Y OR N
07400 ");
07500 DO BEGIN
07600 S←INCHWL;
07700 IF S="Y" THEN FAST←FALSE;
07800 IF S="N" THEN FAST←TRUE;
07900 END UNTIL S="Y" ∨ S="N";
08000 GO TO GET1;
08100
08200 GET:SIMIO(ONE_LINE);
08300 GET1:SETFORMAT(7,2);
08400 GGET:
08500 IF AEF ∧ ARM_STATUS THEN OUTSTR("ARM_STATUS"&CVOS(ARM_STATUS)&CRLF);
08600 IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*"&CRLF);
08700 AEF←FALSE;
08800 I←GETNAME(FALSE,S,FUNNAM);
08900 IF LENGTH(FUNNAM[I]) THEN EXETRUE:CASE FUNNUM[I] OF BEGIN
00100 BEGIN "DOIT"
00200 ARM_EXECUTE←AEF←TRUE;
00300 IF BREAK≠'15
00400 THEN BEGIN I←GETNAME(FALSE,S,FUNNAM);
00500 IF LENGTH(FUNNAM[I]) THEN GO TO EXETRUE END
00600 ELSE S←OFILE;
00700 SAY_WAIT;
00800 IF LENGTH(FILE) THEN BEGIN
00900 CLOSE_TRAJECTORY;
01000 FILE←NULL;
01100 END;
01200 DO_IT(S);
01300 GO TO GET1;
01400 END"DOIT";
01500
01600 BEGIN "REQUIRE"
01700 SIMIO(HEAD);
01800 FILE_NAME[CHAN+1]←(S←SIMIO(ID))&'11;
01900 IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".HAL";
02000 IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
02100 OPEN(CHAN+1,"DSK",0,2,0,120,BREAK,EOF);
02200 LOOKUP(CHAN+1,S,EOF);
02300 IF EOF≠0 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&" "&LINE_NO&"FILE NOT FOUND"&CRLF);
02400 RELEASE(CHAN+1);GO TO GET END;
02450 IF CHAN=1 ∧ ¬MAC THEN SAY_WAIT;
02500 CHAN←CHAN+1;
02600 GO TO GET1;
02700 END "REQUIRE";
02800
02900
03000 BEGIN "TRANS"
03100 INTEGER PTR;
03200 SAFE OWN REAL ARRAY E[1:6];
03300 SAFE OWN REAL ARRAY VT,VTT[1:4];
03400 PTR←GETNAME(FALSE,S,TRANSNAM);
03500 IF ¬LENGTH(TRANSNAM[PTR])
03600 THEN BEGIN
03700 IF FREE_DATA+2>FREE_DATA_LENGTH
03800 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
03900 TRANSNAM[PTR]←S;
04000 TRANSNUM[PTR]←FREE_DATA;
04100 ARRBLT(E[1],ANEW[1],6);
04200 FREE_DATA←FREE_DATA+2 END
04300 ELSE ARRBLT(E[1],DATA_BASE[TRANSNUM[PTR],1],6);
04400 IF ¬MAC ∧ CHAN=1
04500 THEN BEGIN OUTSTR(" X Y Z O A T"&CRLF);
04600 FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(E[I]));
04700 OUTSTR(CRLF&"CHANGE?"&CRLF);
04800 SIMIO(ONE_LINE);
04900 S←SIMIO(ONE_LINE);
05000 FOR I←1 STEP 1 UNTIL 6 DO
05100 IF LENGTH(S) THEN BEGIN
05200 SL←SCAN(S,DEL,IFI);
05300 R←REALSCAN(SL,IFI);
05400 IF IFI≠-1 THEN E[I]←R;
05500 END;
05600 END ELSE FOR I←1 STEP 1 UNTIL 6 DO BEGIN
05700 GETNAME(TRUE,S,VECTNAM);
05800 E[I]←REALSCAN(S,BREAK) END;
05900 ARRBLT(DATA_BASE[TRANSNUM[PTR],1],E[1],6);
06000 IF ¬MAC ∧ CHAN=1
06100 THEN BEGIN CONSTRUCT(TT1,E);
06200 TT1[1,4]←TT1[1,4]/TSX;
06300 TT1[2,4]←TT1[2,4]/TSY;
06400 PMAT(NULL,TT1) END;
06500 GO TO GET1;
06600 END"TRANS";
06700
06800 BEGIN "VECT"
06900 INTEGER PTR;
07000 PTR←GETNAME(FALSE,S,VECTNAM);
07100 IF ¬LENGTH(VECTNAM[PTR])
07200 THEN BEGIN
07300 IF FREE_DATA+1>FREE_DATA_LENGTH
07400 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
07500 VECTNAM[PTR]←S;
07600 VECTNUM[PTR]←FREE_DATA;
07700 FOR I←1 STEP 1 UNTIL 3 DO XV[I]←0;
07800 FREE_DATA←FREE_DATA+1 END
07900 ELSE ARRBLT(XV[1],DATA_BASE[VECTNUM[PTR],1],3);
08000 XV[4]←1;
08100 IF ¬MAC ∧ CHAN=1
08200 THEN BEGIN PVECT(NULL,XV);
08300 OUTSTR("CHANGE ?"&CRLF);
08400 SIMIO(ONE_LINE);
08500 S←SIMIO(ONE_LINE);
08600 FOR I←1 STEP 1 UNTIL 3 DO
08700 IF LENGTH(S) THEN BEGIN
08800 SL←SCAN(S,DEL,IFI);
08900 R←REALSCAN(SL,IFI);
09000 IF IFI≠-1 THEN XV[I]←R;
09100 END;
09200 END ELSE FOR I←1 STEP 1 UNTIL 3 DO BEGIN
09300 GETNAME(TRUE,S,VECTNAM);
09400 XV[I]←REALSCAN(S,BREAK) END;
09500 ARRBLT(DATA_BASE[VECTNUM[PTR],1],XV[1],3);
09600 IF ¬MAC ∧ CHAN=1 THEN PVECT(NULL,XV);
09700 GO TO GET1;
09800 END "VECT";
09900
00100 BEGIN "BEGIN"
00200 IF FILE THEN CLOSE_TRAJECTORY ;
00300 GETNAME(FALSE,FILE,VECTNAM);
00400 SAY_WAIT;
00500 START_TRAJECTORY(FILE,0);
00600 END"BEGIN";
00700
00800 BEGIN "PARK"
00900 SAY_WAIT;
01000 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
01100 PARK_ARM;
01200 END"PARK";
01300
01400 BEGIN "MOVE"
01410 REAL DIST,DEG;
01500 IF READT(TT1,S,"MOVE - "&S&" TRANSFORM DOSN'T EXIST")
01600 THEN BEGIN SIMIO(SOMETHING);
01700 IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
01800 IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
01900 J←0;
02000 IF EQU(S,"SWEEP")THEN J←2;
02100 IF EQU(S,"REACH")THEN J←3;
02200 IF EQU(S,"LIFT")THEN J←1;
02300 IF J THEN FOR I←1 STEP 1 UNTIL 3 DO XV[I]←TT1[J,I];
02400 GETNAME(TRUE,S,FUNNAM);
02500 DIST←REALSCAN(S,BREAK);
02600 IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
02700 J←0;
02800 IF EQU(S,"TURN")THEN J←1;
02900 IF EQU(S,"TWIST")THEN J←3;
03000 IF EQU(S,"TILT")THEN J←2;
03100 IF J THEN FOR I←1 STEP 1 UNTIL 3 DO YV[I]←TT1[J,I];
03200 GETNAME(TRUE,S,FUNNAM);
03300 DEG←REALSCAN(S,BREAK);
03400 SCALE(XV,XV,DIST);
03410 REDUCE(XV);
03415 XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
03420 FOR J←1 STEP 1 UNTIL 3 DO TT1[J,4]←TT1[J,4]+XV[J];
03430 IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
03450 FOR I←1 STEP 1 UNTIL 3 DO BEGIN
03460 CVV(XV,TT1,I);
03470 REVOLVE(XV,YV,DEG);
03480 CVC(TT1,I,XV) END;
03490 END;
03495 END;
03500 SAY_WAIT;
03600 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
03700 MOVE_ARM(TT1,ARM_PLAN);
03800 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNABLE TO MOVE"&CRLF)END
03900 END"MOVE";
04000
04100 BEGIN"STEP"
04200 GETNAME(TRUE,S,FUNNAM);
04300 I←INTSCAN(S,BREAK);
04400 GETNAME(TRUE,S,FUNNAM);
04500 R←REALSCAN(S,BREAK);
04600 GETNAME(TRUE,S,FUNNAM);
04700 J←INTSCAN(S,BREAK);
04800 SAY_WAIT;
04900 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
05000 IF 1≤ I ≤6 THEN STEP_ARM(I,R,J) ELSE OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
05100 END"STEP";
05200
05300 BEGIN "DRAW"
05400 INTEGER I;
05500 SAFE OWN REAL ARRAY PROFILE[1:5,1:4];
05600 SAFE OWN REAL ARRAY DP[1:4];
05700 EXTERNAL SIMPLE PROCEDURE MOVEV(REFERENCE REAL R;REAL ARRAY S);
05800 IF ¬MAC ∧ CHAN=1 THEN BEGIN OUTSTR("POSITION,ROTATION,ANGLE
05900 CRANK,AXIS,DEGREES
06000 TIME,LOOP"&CRLF);
06100 SIMIO(ONE_LINE) END;
06200 IF ¬READV(XV,S,"NEW POSITION MISSING") THEN GO TO GET;
06300 MOVEV(DP[1],XV);
06400 REDUCE(DP);
06500 DP[1]←DP[1]*TSX;
06600 DP[2]←DP[2]*TSY;
06700 MOVEV(PROFILE[1,1],DP);
06800 IF ¬READV(YV,S,"ROTATION AXIS MISSING") THEN GO TO GET;
06900 MOVEV(PROFILE[2,1],YV);
07000 GETNAME(TRUE,S,FUNNAM);
07100 PROFILE[3,1]←REALSCAN(S,BREAK);
07200 IF ¬(READV(XV,S,"CRANK MISSING") ∧ READV(YV,S,"AXIS MISSING"))THEN GO TO GET;
07300 GETNAME(TRUE,S,FUNNAM);
07400 PROFILE[3,2]←REALSCAN(S,BREAK);
07500 MOVEV(PROFILE[4,1],XV);
07600 MOVEV(PROFILE[5,1],YV);
07700 GETNAME(TRUE,S,FUNNAM);
07800 ARM_STAT[2]←INTSCAN(S,BREAK);
07900 GETNAME(TRUE,S,FUNNAM);
08000 ARM_STAT[3]←INTSCAN(S,BREAK);
08100 IF ARM_STAT[3] ∧ ¬(ABS(PROFILE[3,2])=360 ∨ ABS(PROFILE[3,1])=360)
08200 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNLOOPABLE
08300 "); GO TO GET END;
08400 SAY_WAIT;
08500 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
08600 DRAW_ARM(ARM_STAT,PROFILE);
08700 IF ARM_STAT[1] THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"DRAW - SORRY"&CVOS(ARM_STAT[1])&CRLF);
08800 END"DRAW";
08900
00100 BEGIN"FREE"
00200 GETNAME(TRUE,S,FUNNAM);
00300 J←INTSCAN(S,BREAK);
00400 FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
00500 BEGIN
00600 FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
00700 IF READV(XV,S,"MISSING FREE")
00800 THEN BEGIN REDUCE(XV);
00900 ARRBLT(FREE_ARM[I,1],XV[1],3)END;
01000 END;
01100 FREE_ARM[0,1]←FREE_ARM[0,1]+J;
01200 END"FREE";
01300
01400 BEGIN"SPIN"
01500 GETNAME(TRUE,S,FUNNAM);
01600 J←INTSCAN(S,BREAK);
01700 FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
01800 BEGIN
01900 FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
02000 IF READV(XV,S,"MISSING FREE")
02100 THEN BEGIN REDUCE(XV);
02200 ARRBLT(FREE_ARM[I,4],XV[1],3)END;
02300 END;
02400 FREE_ARM[0,1]←FREE_ARM[0,1]+J;
02500 END"SPIN";
02600
02700 BEGIN"FORCE"
02800 IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
02900 THEN BEGIN REDUCE(XV);
03000 ARRBLT(FORCE_ARM[1],XV[1],3);
03100 REDUCE(YV);
03200 ARRBLT(FORCE_ARM[4],YV[1],3) END;
03300 END"FORCE";
03400
03500 BEGIN "STOP"
03600 IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
03700 THEN BEGIN SAY_WAIT;
03800 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
03900 STOP_ARM(XV,YV,ARM_PLAN);
04000 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF) END;
04100 END"STOP";
04200
00100 BEGIN"OPEN_HAND"
00200 GETNAME(TRUE,S,FUNNAM);
00300 R←REALSCAN(S,BREAK);
00400 SAY_WAIT;
00500 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
00600 OPEN_HAND(R);
00700 END"OPEN_HAND";
00800
00900 BEGIN"SKIPE"
01000 STRING SL;
01100 SL←SIMIO(ONE_LINE);
01200 I←CVO(SL);
01300 SAY_WAIT;
01400 ARM_SKIPE(I);
01500 GO TO GET1
01600 END"SKIPE";
01700
01800 BEGIN"JUMP"
01900 STRING SC;
02000 CODE_LINE[PTR3+1]←LINE_NO;
02100 S←SC←SIMIO(ONE_LINE);
02200 SCAN(SC,HEAD,J);
02300 IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
02400 THEN BEGIN SC←BREAK&SC;
02500 I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
02600 SAY_WAIT;
02700 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
02800 ARM_JMP(I);
02900 GO TO GET1;
03000 END"JUMP";
03100
03200 BEGIN "CLOSE_HAND"
03300 GETNAME(TRUE,S,FUNNAM);
03400 R←REALSCAN(S,BREAK);
03500 SAY_WAIT;
03600 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
03700 CLOSE_HAND(R);
03800 END"CLOSE_HAND";
03900
04000 BEGIN "CENTER"
04100 SAFE OWN REAL ARRAY DIR[1:4];
04200 GETNAME(TRUE,S,FUNNAM);
04300 R←REALSCAN(S,BREAK);
04400 SAY_WAIT;
04500 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
04600 CENTER_HAND(R);
04700 END"CENTER";
04800
04900 BEGIN "PLACE"
05000 SAY_WAIT;
05100 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
05200 PLACE_ARM;
05300 END"PLACE";
05400
00100 BEGIN"CHANGE"
00200 REAL DIST,DEG;
00300 INTEGER TIME;
00400 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
00500 IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
00600 J←0;
00700 IF EQU(S,"SWEEP")THEN J←2;
00800 IF EQU(S,"REACH")THEN J←3;
00900 IF EQU(S,"LIFT")THEN J←1;
01000 IF J THEN IF AEF THEN FOR I←1 STEP 1 UNTIL 3 DO XV[I]←ARM_LINK[6,I,J]
01100 ELSE CVV(XV,LAST_TRANS,J);
01200 GETNAME(TRUE,S,FUNNAM);
01300 DIST←REALSCAN(S,BREAK);
01400 IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
01500 J←0;
01600 IF EQU(S,"TURN")THEN J←1;
01700 IF EQU(S,"TWIST")THEN J←3;
01800 IF EQU(S,"TILT")THEN J←2;
01900 IF J THEN IF AEF THEN FOR I←1 STEP 1 UNTIL 3 DO YV[I]←ARM_LINK[6,I,J]
02000 ELSE CVV(YV,LAST_TRANS,J);
02100 GETNAME(TRUE,S,FUNNAM);
02200 DEG←REALSCAN(S,BREAK);
02300 GETNAME(TRUE,S,FUNNAM);
02400 TIME←INTSCAN(S,BREAK);
02500 SAY_WAIT;
02600 CHANGE_ARM(XV,DIST,YV,DEG,TIME,ARM_PLAN);
02700 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"CAREFUL"&CRLF);
02800 END"CHANGE";
02900
03000 BEGIN"DRIVE"
03100 GETNAME(TRUE,S,FUNNAM);
03200 I←INTSCAN(S,BREAK);
03300 GETNAME(TRUE,S,FUNNAM);
03400 R←REALSCAN(S,BREAK);
03500 GETNAME(TRUE,S,FUNNAM);
03600 J←INTSCAN(S,BREAK);
03700 SAY_WAIT;
03800 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
03900 DRIVE_ARM(I,R,J,ARM_PLAN);
04000 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
04100 END"DRIVE";
04200
04300 BEGIN"WAIT"
04400 SAY_WAIT;
04500 WAIT_ARM;
04600 END"WAIT";
04700
04800 BEGIN"MERGE"
04900 SAY_WAIT;
05000 MERGE_ARM;
05100 END"MERGE";
05200
05300 BEGIN"SAVE"
05350 LABEL L1;
05400 GETNAME(FALSE,S,VECTNAM);
05410 FOR I←1 STEP 1 UNTIL MSN DO IF EQU(S,SAVE_NAME[I]) THEN GO TO L1;
05420 FOR I←1 STEP 1 UNTIL 10 DO IF ¬LENGTH(SAVE_NAME[I])
05430 THEN BEGIN SAVE_NAME[I]←S;
05435 IF I>MSN THEN MSN←I;
05440 GO TO L1 END;
05450 OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE SAVE CELL"&CRLF);
05460 GO TO GET;
05600 L1: SAY_WAIT;
05650 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
05700 ARM_SAVE(I);
05800 END"SAVE";
05900
06000 BEGIN"RESTORE"
06010 LABEL L1;
06100 GETNAME(FALSE,S,VECTNAM);
06110 FOR I←1 STEP 1 UNTIL MSN DO IF EQU(S,SAVE_NAME[I]) THEN GO TO L1;
06120 OUTSTR(FILE_NAME[CHAN]&LINE_NO&S&" NOT SAVE CELL"&CRLF);
06130 GO TO GET;
06140 L1: GETNAME(TRUE,S,FUNNAM);
06145 IF INTSCAN(S,BREAK)
06150 THEN BEGIN SAVE_NAME[I]←NULL;
06160 IF I=MSN THEN MSN←MSN-1 END;
06300 SAY_WAIT;
06350 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
06400 ARM_RESTORE(I);
06500 END"RESTORE";
06600
06700 BEGIN "TOUCH"
06800 GETNAME(TRUE,S,FUNNAM);
06900 I←INTSCAN(S,BREAK);
07000 SAY_WAIT;
07100 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
07200 SET_TOUCH(I);
07300 END"TOUCH";
07400
07500 BEGIN"CONO"
07600 IF (READV(XV,S,"ARRIVE DOES NOT EXIST")
07650 ∧ READV(YV,S,"DEPART DOES NOT EXIST")
07675 ∧ READV(ZV,S,"OBJECT DOES NOT EXIST"))
07700 THEN BEGIN
07800 GETNAME(TRUE,S,FUNNAM);
07850 ZV[4]←REALSCAN(S,BREAK);
07875 GETNAME(TRUE,S,FUNNAM);
07900 I←INTSCAN(S,BREAK);
08000 GETNAME(TRUE,S,FUNNAM);
08100 J←INTSCAN(S,BREAK);
08200 SAY_WAIT;
08300 ARM_CONO(XV,YV,ZV,I,J);
08400 END;
08500 END "CONO";
08600
08700 BEGIN"END"
08800 SAY_WAIT;
08810 FOR I←1 STEP 1 UNTIL 10 DO SAVE_NAME[I]←NULL;
08855 MSN←0;
08900 CLOSE_TRAJECTORY;
09000 FILE←NULL;
09100 END"END";
09200
00100 IF LENGTH(FILE) THEN FLUSH(0,LAST_ARM);
00200
00300 BEGIN "PROCEED"
00400 SAY_WAIT;
00500 DO_PROCEED;
00600 AEF←TRUE;
00700 END"PROCEED";
00800
00900 BEGIN"PROTO"
01000 GETNAME(FALSE,S,VECTNAM);
01100 GLOBAL ERASE INSTANCE⊗ANY≡TEST_BLOCK;
01200 IF EQU(S,"WEDGE")THEN GLOBAL MAKE INSTANCE⊗WEDGE124≡TEST_BLOCK ELSE
01300 IF EQU(S,"RPP")THEN GLOBAL MAKE INSTANCE⊗RPP112≡TEST_BLOCK ELSE
01400 GLOBAL MAKE INSTANCE⊗CUBE≡TEST_BLOCK;
01500 END"PROTO";
01600
01700 BEGIN"FILE"
01800 GETNAME(FALSE,OFILE,VECTNAM);
02000 END"FILE";
02100
02200 BEGIN"I"
02300 IF ¬MAC ∧ CHAN=1 THEN FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(ARM_VECTOR[I]));
02400 IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CRLF);
02500 END"I";
02600
02700 BEGIN "MOVEINST"
02800 IF ¬READT(XT,S,"INSTANCE TRANSFORM DOSN'T EXIST")THEN GO TO GET;
02900 ARRTRAN ( GLOBAL DATUM(TEST_BLOCK),XT);
03000 IF ¬READT(XT,S,"NEW TRANSFORM DOSN'T EXIST")THEN GO TO GET;
03100 IF ¬READV(YV,S,"INTERMEDIATE POSITION DOSN'T EXIST")THEN GO TO GET;
03200 SAY_WAIT;
03300 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
03400 ISSUE(7,"HAND","MOVE",MESSAGE MOVE_INSTANCE(TEST_BLOCK,XT,YV,ARM_PLAN));
03500 IF ARM_PLAN ≤0 THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY "&CVS(ARM_PLAN)&CRLF)
03600 ELSE BEGIN
03700 IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CVS(ARM_PLAN/2)&" MOVE"&CRLF);
03800 FOR I←1 STEP 1 UNTIL 3*ARM_PLAN DO
03900 QUEUE('600, GET_ENTRY('120,NULL,"HAND",NULL));
04000 END;
04100 END "MOVEINST";
04200
00100 BEGIN"LINK"
00200 SAFE OWN REAL ARRAY T[1:4,1:4];
00300 GETNAME(TRUE,S,FUNNAM);
00400 I←INTSCAN(S,BREAK);
00500 IF I<3 ∨ I>6 THEN BEGIN OUTSTR("THAT LINK IS NOT AVAILABLE"&CRLF);GO TO GET END;
00600 ARRBLT(T[1,1],ARM_LINK[I,1,1],16);
00700 T[1,4]←T[1,4]/TSX;
00800 T[2,4]←T[2,4]/TSY;
00900 IF ¬MAC ∧ CHAN=1 THEN PMAT(NULL,T);
01000 END"LINK";
01100
01200 IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CVF(GRASP)&CRLF);
01300
01400 BEGIN"WEIGHT"
01500 PRELOAD_WITH 0,0,-1,0,0,0;SAFE OWN REAL ARRAY ONE_OZ[1:6];
01600 SAFE OWN REAL ARRAY TORQUE[1:6];
01700 INTEGER I; REAL WR,WO;
01800 LABEL FIND;
01900 FIND: FORCE(TORQUE,ONE_OZ);
02000 WR←WO←0;
02100 FOR I←1 STEP 1 UNTIL 6 DO BEGIN
02200 WR←WR+TORQUE[I]*TORQUE[I];
02300 WO←WO-ARM_TORQUE[I]*TORQUE[I];
02400 END;
02500 IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CVF(WO/WR)&" OZS."&CRLF);
02600 END;"WEIGHT"
02700
02800 BEGIN"WOBBLE"
02810 GETNAME(TRUE,S,FUNNAM);
02820 R←REALSCAN(S,BREAK);
02830 SAY_WAIT;
02840 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
02850 WOBBLE_HAND(R);
02860 END"WOBBLE";
02900
03000 BEGIN "POS"
03100 SAFE OWN REAL ARRAY T[1:4,1:4];
03200 SAY_WAIT;
03300 ARM_POSITION;
03400 ARRBLT(T[1,1],ARM_LINK[6,1,1],16);
03500 T[1,4]←T[1,4]/TSX;
03600 T[2,4]←T[2,4]/TSY;
03700 IF ¬MAC ∧ CHAN=1 THEN PMAT(NULL,T);
03800 END "POS";
03900
04000 BEGIN"SKIPN"
04100 STRING SL;
04200 SL←SIMIO(ONE_LINE);
04300 I←CVO(SL);
04400 SAY_WAIT;
04500 ARM_SKIPN(I);
04600 GO TO GET1
04700 END"SKIPN";
04800
04900 BEGIN"SKIPS"
05000 STRING SL;
05100 SL←SIMIO(ONE_LINE);
05200 I←CVO(SL);
05300 SAY_WAIT;
05400 ARM_SKIPS(I);
05500 GO TO GET1
05600 END"SKIPS";
05700
00100 BEGIN "DEFINE"
00200 STRING ARRAY ARG[1:10];
00300 INTEGER TMN;
00400 I←GETNAME(FALSE,S,FUNNAM);
00500 IF LENGTH(FUNNAM[I]) THEN OUTSTR(S&" MACRO NAME RESERVED WORD"&CRLF);
00600 FOR TMN←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[TMN]) THEN DONE;
00700 IF TMN>FMN THEN MACRO_NAME[TMN]←S;
00800 MACRO_FORMAL[TMN]←S←SIMIO(ONE_LINE);
00900 J←0;
01000 WHILE LENGTH(S)
01100 DO BEGIN SCAN(S,HEAD,BREAK);
01200 IF BREAK=";" THEN DONE;
01300 SL←SCAN(S,ID,BREAK);
01400 IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
01500 PUSH_FORMAT(0,0);
01600 MACRO_DEFN[TMN]←NULL;
01700 WHILE TRUE
01800 DO BEGIN S←SIMIO(ONE_LINE);
01900 IF ¬LENGTH(S) THEN DONE;
02000 WHILE LENGTH(S) DO BEGIN
02100 SCAN(S,SOME,BREAK);
02200 IF BREAK=";" THEN DONE;
02300 IF "A" ≤ BREAK ≤ "Z"
02400 THEN BEGIN SL←SCAN(S,ID,BREAK);
02500 FOR I←1 STEP 1 UNTIL J
02600 DO IF EQU(SL,ARG[I])
02700 THEN BEGIN SL←"$"&CVS(I);
02800 DONE END;
02900 IF BREAK=":" THEN SL←SL&":";
03000 IF BREAK="+" ∨ BREAK="-" THEN S←BREAK&S END
03100 ELSE SL←SCAN(S,NNUMS,BREAK);
03200 MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&SL&(IF LENGTH(S) THEN " " ELSE NULL);
03300 IF BREAK=";" THEN DONE;
03400 END;
03500 MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&'15&'12;
03600 END;
03700 POP_FORMAT;
03800 OUTSTR(MACRO_NAME[TMN]&(IF TMN≤FMN THEN " REDEFINED" ELSE " DEFINED")&CRLF);
03900 IF TMN>FMN THEN FMN←TMN;
04000 GO TO GET1;
04100 END "DEFINE";
04200
00100 BEGIN "DUMP"
00200 STRING ARRAY ARG[1:10];
00300 OUTSTR("FILE NAME"&CRLF);
00400 SIMIO(HEAD);
00500 S←SIMIO(ID);
00600 IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".HAL";
00700 IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
00800 OPEN(CHAN←CHAN+1,"DSK",0,0,3,120,BREAK,EOF);
00900 ENTER(CHAN,S,EOF);
01000 FOR I←0 STEP 1 UNTIL '77 DO
01100 IF LENGTH(TRANSNAM[I]) THEN BEGIN
01200 OUT(CHAN,"TRANS "&TRANSNAM[I]&" ");
01300 ARRBLT(DIR[1],DATA_BASE[TRANSNUM[I],1],6);
01400 FOR J←1 STEP 1 UNTIL 6 DO OUT(CHAN,CVF(DIR[J]));
01500 OUT(CHAN,CRLF);
01600 END;
01700 OUT(CHAN,CRLF&CRLF);
01800 FOR I←0 STEP 1 UNTIL '77 DO
01900 IF LENGTH(VECTNAM[I]) ∧ VECTNUM[I] THEN BEGIN
02000 OUT(CHAN,"VECT "&VECTNAM[I]&" ");
02100 ARRBLT(DIR[1],DATA_BASE[VECTNUM[I],1],3);
02200 FOR J←1 STEP 1 UNTIL 3 DO OUT(CHAN,CVF(DIR[J]));
02300 OUT(CHAN,CRLF);
02400 END;
02500 OUT(CHAN,CRLF&CRLF);
02600 FOR I←1 STEP 1 UNTIL FMN DO BEGIN
02700 OUT(CHAN,"DEFINE "&MACRO_NAME[I]&" ");
02800 OUT(CHAN,S←MACRO_FORMAL[I]&"
02900 ");
03000 J←0;
03100 WHILE LENGTH(S)
03200 DO BEGIN SCAN(S,HEAD,BREAK);
03300 IF BREAK=";" THEN DONE;
03400 SL←SCAN(S,ID,BREAK);
03500 IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
03600 S←MACRO_DEFN[I];
03700 WHILE LENGTH(S) DO BEGIN
03800 OUT(CHAN,SCAN(S,DOLLAR,BREAK));
03900 IF LENGTH(S) THEN OUT(CHAN,ARG[INTSCAN(S,BREAK)]&
03950 (IF BREAK='12 THEN '15 ELSE NULL));
04000 END;
04100 OUT(CHAN,CRLF&CRLF);
04200 END;
04300 RELEASE(CHAN);
04400 CHAN←CHAN-1;
04500 END "DUMP";
04600
00100 BEGIN"SET"
00200 LABEL L1;
00250 REAL DIST,DEG;
00275 INTEGER CELL;
00300 GETNAME(FALSE,S,VECTNAM);
00400 FOR CELL←1 STEP 1 UNTIL MSN DO IF EQU(S,SAVE_NAME[CELL]) THEN GO TO L1;
00500 FOR CELL←1 STEP 1 UNTIL 10 DO IF ¬LENGTH(SAVE_NAME[CELL])THEN GO TO L1;
00900 OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE SAVE CELL"&CRLF);
01000 GO TO GET;
01100 L1: IF ¬READT(TT1,S,S&" TRANSFORM DOSN'T EXIST") THEN GO TO GET;
01500 IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
01600 J←0;
01700 IF EQU(S,"SWEEP")THEN J←2;
01800 IF EQU(S,"REACH")THEN J←3;
01900 IF EQU(S,"LIFT")THEN J←1;
02000 IF J THEN FOR I←1 STEP 1 UNTIL 3 DO XV[I]←TT1[J,I];
02200 GETNAME(TRUE,S,FUNNAM);
02300 DIST←REALSCAN(S,BREAK);
02400 IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
02500 J←0;
02600 IF EQU(S,"TURN")THEN J←1;
02700 IF EQU(S,"TWIST")THEN J←3;
02800 IF EQU(S,"TILT")THEN J←2;
02900 IF J THEN FOR I←1 STEP 1 UNTIL 3 DO YV[I]←TT1[J,I];
03100 GETNAME(TRUE,S,FUNNAM);
03200 DEG←REALSCAN(S,BREAK);
03300 SCALE(XV,XV,DIST);
03400 SAY_WAIT;
03450 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((FILE←OFILE),0);
03500 SET_ARM(CELL,TT1,XV,YV,DEG,ARM_PLAN);
04500 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
04510 SAVE_NAME[CELL]←S;
04520 IF CELL>MSN THEN MSN←CELL;
04900 END"SET";
05000
00100 IFC GRAPHICS THENC
00200 BEGIN "DISPLAY"
00300 SAFE INTEGER ARRAY DISPLY[1:'3000];
00400 LABEL TOP;
00500 INTEGER POG;
00600 SAFE INTEGER ARRAY FDATA[0:'2200];
00700 STRING SIMPLE PROCEDURE SCAN_DATA(INTEGER TL,TU;STRING IND;SIMPLE PROCEDURE UP);
00800 BEGIN INTEGER ERROR,TICK,REQD,THIS,N;
00900 INTEGER MISSED;
01000 BOOLEAN FIRST;
01100 LABEL NEXT;
01200 LOOKUP('17,DFILE&".TMP",EOF);
01300 IF EOF THEN RETURN("FILE NOT FOUND");
01400 REQD←CVSIX(IND);
01500 TICK←CVSIX("TICK");
01600 ERROR←CVSIX("ERROR");
01700 TIME←-1;
01800 FIRST←TRUE;
01900 MISSED←0;
02000 PTR←0;
02100 BP←0;
02200 HIT←0;
02300 ARRYIN('17,FDATA[0],'200);
02400 DO BEGIN "READ_LOOP"
02500 ARRYIN('17,FDATA['200],'2000);
02600 DO BEGIN "ITEM_LOOP"
02700 THIS←FDATA[PTR] LAND '777777777700;
02800 IF ¬THIS THEN RETURN(NULL);
02900 IF THIS=TICK THEN BEGIN
03000 MISSED←0;
03100 TIME←TIME+1;
03200 IF TIME<TL THEN GO TO NEXT;
03300 IF TIME>TU THEN RETURN(NULL);
03400 HIT←HIT+1;
03500 IF MODULUS<2 ∨ ¬(HIT MOD MODULUS) THEN BEGIN
03600 BUFFER[BP+1]←BUFFER[BP];
03700 BP←BP+1;
03800 END;
03900 END;
04000 IF THIS=REQD THEN BEGIN
04100 UP;
04200 IF FIRST THEN BEGIN
04300 BUFFER[1]←BUFFER[BP];
04400 ARRBLT(BUFFER[2],BUFFER[1],BP-2);
04500 FIRST←FALSE;
04600 END;
04700 END;
04800 NEXT: IF(N←FDATA[PTR] LAND '77)>'37 ∨ THIS=ERROR THEN
04900 BEGIN MISSED←-1;
05000 OUTSTR(CVS(TIME)&" DATA MISSED");
05100 END;
05200 PTR←PTR+1+(IF MISSED THEN 0 ELSE N);
05300 END UNTIL PTR>'1777;
05400 PTR←PTR-'2000;
05500 ARRBLT(FDATA[0],FDATA['2000],'200);
05600 END UNTIL EOF;
05700 RETURN("END OF FILE");
05800 END"SCAN_DATA";
05900
06000 PROCEDURE WHEN;
06100 BEGIN
06200 INTEGER I;
06300 PRELOAD_WITH "OPEN_HAND","CLOSE_HAND","WAIT_ARM","PLACE_ARM","CHANGE_ARM","SET_TOUCH","FORCE_ARM";
06400 SAFE OWN STRING ARRAY FUNCTION[1:7];
06500 IF (I←FDATA[PTR+1] LAND '777777) THEN SM←SM&CVS(TIME)&" "&FUNCTION[I]&CRLF ELSE
06600 IF FDATA[PTR+1] LAND '10000000 THEN SM←SM&CVS(TIME)&" "&"NULL_ARM"&CRLF ELSE
06700 IF FDATA[PTR+1] LAND '20000000 THEN SM←SM&CVS(TIME)&" "&"MOVE_ARM"&CRLF;
06800 END;
06900
07000 SIMPLE PROCEDURE REAL6;
07100 BEGIN
07200 INTEGER I;
07300 REAL R;
07400 I←FDATA[PTR+7-INDEX];
07500 START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
07600 BUFFER[BP]←R;
07700 END;
07800
07900 SIMPLE PROCEDURE REAL1;
08000 BEGIN
08100 INTEGER I;
08200 REAL R;
08300 I←FDATA[PTR+1];
08400 START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
08500 BUFFER[BP]←R;
08600 END;
08700
08800 SIMPLE PROCEDURE INT1;BUFFER[BP]←FDATA[PTR+1];
08900
09000 SIMPLE PROCEDURE INT6;
09100 BUFFER[BP]←FDATA[PTR+7-INDEX];
09200
09300 PROCEDURE BIGHT;
09400 BEGIN LABEL FOUND;
09500 INTEGER BITE,T,I,J,K;
09600 SAFE INTEGER ARRAY FEEL[1:2,1:2,1:4];
09700 START_CODE
09800 HRRZI 1,FDATA;
09900 HRR 1,(1);
10000 ADD 1,PTR;
10100 HRLI 1,'1400;
10200 MOVEM 1,BITE;
10300 END;
10400 FOR I←2 STEP -1 UNTIL 1 DO BEGIN"FINGER"
10500 FOR J←2 STEP -1 UNTIL 1 DO
10600 FOR K←4 STEP -1 UNTIL 1 DO
10700 IF INDEX=I ∧ TIP=J ∧ PAD=K THEN
10800 BEGIN"THE ONE"
10900 T←ILDB(BITE);
11000 START_CODE
11100 LABEL POS,BACK;
11200 MOVE 1,T;
11300 TRNE 1,'2000;
11400 JRST POS;
11500 TRZ 1,'774000;
11600 JRST BACK;
11700 POS: TDO 1,NMASK;
11800 BACK: MOVNM 1,T;
11900 END;
12000 GO TO FOUND;
12100 END "THE ONE" ELSE IBP(BITE);
12200 IBP(BITE);
12300 END "FINGER";
12400 FOUND: BUFFER[BP]←T;
12500 END;
12600 STRING SL;
00100 SL←SIMIO(ONE_LINE);
00200 SCAN(SL,HEAD,BREAK);
00300 IF ¬LENGTH(DFILE←SCAN(SL,ID,BREAK)) THEN DFILE←OFILE;
00400 OPEN('17,"DSK",'17,0,0,120,BREAK,EOF);
00500 MODULUS←1000;
00600 SM←"
00700 TIME FUNCTION"&CRLF;
00800 SETFORMAT(4,0);
00900 S11←SCAN_DATA(0,5000,"NEXT",WHEN);
01000 SM←SM&CVS(TIME)&" "&S11&CRLF;
01100 OUTSTR(SM);
01200 OUTSTR("DISPLAY, FUNCTION, FROM, TO ?"&CRLF);
01300 SETFORMAT(0,0);
01400 WHILE TRUE DO BEGIN
01500 INPUT(1,HEAD);S11←INPUT(1,ID);
01600 IF EQU(S11,"X") THEN DONE;
01700 IF EQU(S11,"N") THEN BEGIN RELEASE('17);GO TO GET END;
01800 IF EQU(S11,"C") THEN BEGIN DPYCLR;RELEASE('17);GO TO GET END;
01900 IF EQU(S11,"P") THEN BEGIN
02000 STRING FILNAM;
02100 INTEGER FLG,CHN;
02200 CHN ← 14;
02300 OPEN(CHN,"DSK",8,0,3,0,0,0);
02400 DO BEGIN
02500 OUTSTR(13&10&"PLOT FILE = ");
02600 FILNAM ← INCHWL;
02700 ENTER(CHN,FILNAM&".PLT",FLG);
02800 END UNTIL ¬FLG;
02900 ARRYOUT(CHN,DISPLY[1],DISPLY[2]);
03000 RELEASE(CHN);
03100 GO TO TOP;
03200 END;
03300 INPUT(1,HEAD);FUNCTION←INPUT(1,ID);
03400 IF EQU(S11,"D")THEN BEGIN
03500 LL←INTIN(1);
03600 UL←INTIN(1);
03700 MODULUS←1+(UL-LL)%100;
03800 DPYCLR;
03900 POG←GETPOG;
04000 DPYSET(DISPLY);
04100 AIVECT(-511,450);
04200 END;
04300 IF EQU(FUNCTION,"THETA")THEN BEGIN
04400 OUTSTR("INDEX ?"&CRLF);
04500 INDEX←INTIN(1);
04600 FACTOR←THFAC[INDEX];
04700 SCAN_DATA(LL,UL,"THETA",REAL6);
04800 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
04900 "ERROR "&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
05000 DPYOUT(POG);
05100 GO TO TOP;
05200 END;
05300
05400 IF EQU(FUNCTION,"MOTOR")THEN BEGIN
05500 OUTSTR("INDEX ?"&CRLF);
05600 INDEX←INTIN(1);
05700 SCAN_DATA(LL,UL,"DAC",INT6);
05800 FOR I←1 STEP 1 UNTIL BP DO BUFFER[I]←BUFFER[I]*300/'776000;
05900 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
06000 "MOTOR "&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
06100 DPYOUT(POG);
06200 GO TO TOP;
06300 END;
06400 IF EQU(FUNCTION,"DRIVE")THEN BEGIN
06500 OUTSTR("INDEX ?"&CRLF);
06600 INDEX←7-INTIN(1);
06700 FACTOR←10.0;
06800 SCAN_DATA(LL,UL,"BACK",REAL6);
06900 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
07000 "DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
07100 BP←HIT←0;
07200 SCAN_DATA(LL,UL,"FORD",REAL6);
07300 ARRGRF(BUFFER,1,BP,-300,-300,0,700,"T/"&CVS(MODULUS),
07400 "DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
07500 DPYOUT(POG);
07600 GO TO TOP;
07700 END;
07800 IF EQU(FUNCTION,"HAND")THEN BEGIN
07900 FACTOR←100.0;
08000 SCAN_DATA(LL,UL,"HAND",REAL1);
08100 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
08200 "HAND FROM "&CVS(LL)&" TO "&CVS(UL));
08300 DPYOUT(POG);
08400 GO TO TOP;
08500 END;
08600 IF EQU(FUNCTION,"TIME")THEN BEGIN
08700 SCAN_DATA(LL,UL,"TICK",INT1);
08800 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
08900 "TIME FROM "&CVS(LL)&" TO "&CVS(UL));
09000 DPYOUT(POG);
09100 GO TO TOP;
09200 END;
09300 IF EQU(FUNCTION,"TOUCH")THEN BEGIN
09400 OUTSTR("FINGER, TIP ?"&CRLF);
09500 INDEX←INTIN(1);
09600 TIP←INTIN(1);
09700 FOR PAD←1 STEP 1 UNTIL 4 DO BEGIN
09800 SCAN_DATA(LL,UL,"TOUCH",BIGHT);
09900 ARRGRF(BUFFER,1,BP,-300,-300+(PAD-1)*180,800,150,"T/"&CVS(MODULUS),
10000 "TOUCH FROM "&CVS(LL)&" TO "&CVS(UL));
10100 END;
10200 DPYOUT(POG);
10300 GO TO TOP;
10400 END;
10500 OUTSTR("UNRECOGINZED COMMAND"&CRLF);
10600 TOP:END;
10700 END"DISPLAY";
10800 ENDC
10900
00100 END ELSE
00200 BEGIN
00300 FOR I←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[I])
00400 THEN BEGIN
00500 S←SIMIO(ONE_LINE);
00600 OUTSTR(MACRO_NAME[I]&CRLF);
00700 MAC←MAC+1;
00800 MACRO_SOURCE[MAC]←MACRO_DEFN[I];
00900 MAC_TOP[MAC]←MAC_FREE;
01000 WHILE LENGTH(S) DO BEGIN
01100 SCAN(S,SOME,BREAK);
01200 IF BREAK="$"
01300 THEN BEGIN I←INTSCAN(S,BREAK);
01400 I←I+MAC_TOP[MAC-1];
01500 IF I<1 ∨ I> MAC_TOP[MAC]
01600 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
01700 GO TO GET END;
01800 SL←MAC_PAR[I] END
01900 ELSE SL←IF "A"≤ BREAK ≤"Z" THEN SCAN(S,ID,I) ELSE SCAN(S,NNUMS,I);
02000 IF LENGTH(SL) THEN MAC_PAR[MAC_FREE←MAC_FREE+1]←SL END;
02100 BBEG[MAC]←PTR3+1;
02200 LLAB[MAC]←FREEL+1;
02300 GO TO GET1;
02400 END;
02500
02600 OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNRECOGINIZED COMMAND"&CRLF);
02700 END;
02800 GO TO GET;
02900 ENDC
03000 END;
03100